home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / adatimer.zip / TIMEL2.ADA < prev    next >
Text File  |  1990-06-07  |  7KB  |  231 lines
  1. -- Listing 2.  An implementation dependent package body.
  2.  
  3. with PORT, BIT_OPS;
  4. package body POLLED_TIMER is
  5.  
  6.   TIMER_TICK : float := 1.0 / 1_193_180.0;
  7.   TIMER_MAX  : float := 65_536.0 * TIMER_TICK;
  8.  
  9.   type Words is range 0 .. 65_535;
  10.     for Words'SIZE use 32;
  11.  
  12.   TIMER_PERIOD : Words;
  13.   LOW_BYTE     : integer;
  14.   HIGH_BYTE    : integer;
  15.   TIMER_MODE   : Modes;
  16.  
  17.   -- IBM PC physical addresses.
  18.   TIMER_BASE_ADDRESS : constant
  19.     := 16#40#;
  20.   TIMER_2_REGISTER   : constant
  21.     := TIMER_BASE_ADDRESS + 2;
  22.   TIMER_CONTROL      : constant
  23.     := TIMER_BASE_ADDRESS + 3;
  24.   SPEAKER_CONTROL    : constant
  25.     := 16#61#;
  26.  
  27.   -- IBM PC physical constants.
  28.   TIMER_2_GATE    : constant
  29.     := 2#0000_0001#;
  30.   SPEAKER_ENABLE  : constant
  31.     := 2#0000_0010#;
  32.   
  33.   -- Intel 8254 constants
  34.   -- (See Intel 8254 data sheet.)
  35.   TIMER_2_MODE_0          : constant
  36.     := 2#10_11_000_0#;
  37.   READBACK_TIMER_2_STATUS : constant
  38.     := 2#11_10_100_0#;
  39.   TIMER_2_READ_COUNT      : constant
  40.     := 2#11_01_100_0#;
  41.   OUTPUT_FLAG             : constant
  42.     := 2#1000_0000#;
  43.   NOT_FINISHED            : constant
  44.     := 0;
  45.  
  46.   -- Temporary variable (made global
  47.   -- to avoid frequent elaboration).
  48.   STATUS : integer;
  49.  
  50.   function Make_Word(HIGH_BYTE, LOW_BYTE : integer)
  51.       return Words is
  52.     WORD, HIGH, LOW : Words;
  53.   begin
  54.     HIGH := 256 * Words(HIGH_BYTE);
  55.     LOW  := Words(LOW_BYTE);
  56.     WORD := HIGH + LOW;
  57.     return WORD;
  58.   end Make_Word;
  59.  
  60.   function Lsb(WORD : Words) return integer is
  61.     LOW : integer;
  62.   begin
  63.     LOW  := integer(WORD mod 256);
  64.     return LOW;
  65.   end Lsb;
  66.  
  67.   function Msb(WORD : Words) return integer is
  68.     HIGH : integer;
  69.   begin
  70.     HIGH  := integer(WORD / 256);
  71.     return HIGH;
  72.   end Msb;
  73.  
  74.   -- The following is a Meridian 4.0 bug work-around.
  75.   -- Meridian computes float(WORD) = negative when
  76.   -- WORD is of type Words and greater than 32,767.
  77.   function To_Float(WORD : Words) return float is
  78.     HIGH, LOW : float;
  79.   begin
  80.     HIGH := float(Msb(WORD));
  81.     LOW  := float(Lsb(WORD));
  82.     return 256.0 * HIGH + LOW;
  83.   end To_Float;
  84.  
  85.   procedure Set(PERIOD : Seconds;
  86.                 MODE   : Modes) is
  87.   begin
  88.     -- Check for range errors.
  89.     if Dimensionless(PERIOD) > TIMER_MAX then
  90.       raise INVALID_PERIOD;
  91.     end if;
  92.     if Dimensionless(PERIOD) < TIMER_TICK then
  93.       raise INVALID_PERIOD;
  94.     end if;
  95.     -- Make sure the timer is stopped.
  96.     Stop;
  97.     -- Convert seconds into clock ticks.
  98.     TIMER_PERIOD := Words(Dimensionless(PERIOD)
  99.       /TIMER_TICK);
  100.     -- Load the clock ticks into the timer.
  101.     LOW_BYTE  := Lsb(TIMER_PERIOD);
  102.     HIGH_BYTE := Msb(TIMER_PERIOD);
  103.     PORT.Out_Byte(TIMER_2_REGISTER,LOW_BYTE);
  104.     PORT.Out_Byte(TIMER_2_REGISTER,HIGH_BYTE);
  105.     -- Set the mode (single or repreated).
  106.     TIMER_MODE := MODE;
  107.   end Set;
  108.  
  109.   procedure Start is
  110.     use BIT_OPS; -- for "or" (bit set)
  111.   begin
  112.     -- Get current status.
  113.     STATUS := PORT.In_Byte(SPEAKER_CONTROL);
  114.     -- Set Timer 2 gate without affecting other control
  115.     -- bits.
  116.     STATUS := STATUS or TIMER_2_GATE;
  117.     -- Put modified status.
  118.     PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  119.   end Start;
  120.  
  121.   procedure Restart is
  122.     use BIT_OPS; -- for "or" (bit set)
  123.   begin
  124.     -- Load the clock ticks into the timer.
  125.     PORT.Out_Byte(TIMER_2_REGISTER,LOW_BYTE);
  126.     PORT.Out_Byte(TIMER_2_REGISTER,HIGH_BYTE);
  127.     -- Start the timer.
  128.     Start;
  129.   end Restart;
  130.  
  131.   function Has_Expired return boolean is
  132.     use BIT_OPS; -- for "and"
  133.   begin
  134.     -- Latch status.
  135.     PORT.Out_Byte(TIMER_CONTROL,READBACK_TIMER_2_STATUS);
  136.     STATUS := Port.In_Byte(TIMER_2_REGISTER);
  137.     if (STATUS and OUTPUT_FLAG) = NOT_FINISHED then
  138.       return FALSE;
  139.     else
  140.       case TIMER_MODE is
  141.         when SINGLE =>
  142.           return TRUE;
  143.         when REPEATED =>
  144.           Restart;
  145.           return TRUE;
  146.       end case;
  147.     end if;
  148.   end Has_Expired;
  149.  
  150.   procedure Stop is
  151.     use BIT_OPS; -- for "and" and "not" (bit clear)
  152.   begin
  153.     -- Get current status.
  154.     STATUS := PORT.In_Byte(SPEAKER_CONTROL);
  155.     -- Clear Timer 2 gate without affecting other control
  156.     -- bits.
  157.     STATUS := STATUS and not TIMER_2_GATE;
  158.     -- Put modified status.
  159.     PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  160.   end Stop;
  161.  
  162.   function Time_Used return Seconds is
  163.     MSB, LSB : integer;
  164.     CURRENT_VALUE, DIFFERENCE : Words;
  165.     TIME : float;
  166.   begin
  167.     -- Latch the current count (without stopping
  168.     -- the timer).
  169.     PORT.Out_Byte(TIMER_CONTROL,TIMER_2_READ_COUNT);
  170.     LSB := PORT.In_Byte(TIMER_2_REGISTER);
  171.     MSB := PORT.In_Byte(TIMER_2_REGISTER);
  172.     CURRENT_VALUE := Make_Word(MSB,LSB);
  173.     DIFFERENCE := TIMER_PERIOD - CURRENT_VALUE;
  174.     -- Meridian 4.0 incorrectly computes the next line.
  175.     -- TIME := float(DIFFERENCE) * TIMER_TICK;
  176.     TIME := To_Float(DIFFERENCE) * TIMER_TICK;
  177.     return Type_Convert(TIME);
  178.   end Time_Used;
  179.  
  180.   function Time_Left return Seconds is
  181.     MSB, LSB : integer;
  182.     CURRENT_VALUE : Words;
  183.     TIME : float;
  184.   begin
  185.     -- Latch the current count (without stopping
  186.     -- the timer).
  187.     PORT.Out_Byte(TIMER_CONTROL,TIMER_2_READ_COUNT);
  188.     LSB := PORT.In_Byte(TIMER_2_REGISTER);
  189.     MSB := PORT.In_Byte(TIMER_2_REGISTER);
  190.     CURRENT_VALUE := Make_Word(MSB,LSB);
  191.     -- Meridian 4.0 incorrectly computes the next line.
  192.     -- TIME := float(CURRENT_VALUE) * TIMER_TICK;
  193.     TIME := To_Float(CURRENT_VALUE) * TIMER_TICK;
  194.     return Type_Convert(TIME);
  195.   end Time_Left;
  196.  
  197.   function Max_Period return Seconds is
  198.   begin
  199.     return Type_Convert(TIMER_MAX);
  200.   end Max_Period;
  201.  
  202.   function Single_Tick return Seconds is
  203.   begin
  204.     return Type_Convert(TIMER_TICK);
  205.   end Single_Tick;
  206.  
  207.   -- This package uses Timer 2, which is
  208.   -- usually used to beep the speaker.
  209.   -- This procedure disables the speaker.
  210.   procedure Turn_Off_Speaker is
  211.     use BIT_OPS; -- for "and" (bit clear)
  212.   begin
  213.     -- Get current status.
  214.     STATUS := PORT.In_Byte(SPEAKER_CONTROL);
  215.     -- Clear SPEAKER_ENABLE bit without affecting
  216.     -- other control bits.
  217.     STATUS := STATUS and not SPEAKER_ENABLE;
  218.     -- Put modified status.
  219.     PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  220.   end Turn_Off_Speaker;
  221.  
  222.   procedure Initialize_Timer_2 is
  223.   begin
  224.     PORT.Out_Byte(TIMER_CONTROL,TIMER_2_MODE_0);
  225.   end Initialize_Timer_2;
  226.  
  227. begin
  228.   Turn_Off_Speaker;  -- so we won't hear the timer!
  229.   Initialize_Timer_2;
  230. end POLLED_TIMER;
  231.